home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE16 / RTTI / MethForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-27  |  4.3 KB  |  157 lines
  1. unit MethForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, TypInfo;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Listbox1: TListBox;
  12.     ListBox2: TListBox;
  13.     Label1: TLabel;
  14.     procedure Listbox1Click(Sender: TObject);
  15.     procedure FormCreate(Sender: TObject);
  16.   public
  17.     procedure AddType (pti: PTypeInfo);
  18.   end;
  19.  
  20.   procedure ShowMethod (pti: PTypeInfo; sList: TStrings);
  21.  
  22. var
  23.   Form1: TForm1;
  24.  
  25. implementation
  26.  
  27. {$R *.DFM}
  28.  
  29. procedure TForm1.Listbox1Click(Sender: TObject);
  30. var
  31.   pti: PTypeInfo;
  32. begin
  33.   pti := PTypeInfo (ListBox1.Items.Objects [
  34.     Listbox1.ItemIndex]);
  35.   ListBox2.Items.Clear;
  36.   ShowMethod (pti, ListBox2.Items);
  37. end;
  38.  
  39. type
  40.   TParamData = record
  41.     Flags: TParamFlags;
  42.     ParamName: ShortString;
  43.     TypeName: ShortString;
  44.     // beware: string length varies!!!
  45.   end;
  46.   PParamData = ^TParamData;
  47.  
  48. // show RTTI information for method pointers
  49. procedure ShowMethod (pti: PTypeInfo; sList: TStrings);
  50. var
  51.   ptd: PTypeData;
  52.   pParam: PParamData;
  53.   nParam: Integer;
  54.   Line: string;
  55.   pTypeString, pReturnString: ^ShortString;
  56. begin
  57.   // protect against misuse
  58.   if pti^.Kind <> tkMethod then
  59.     raise Exception.Create ('Invalid type information');
  60.  
  61.   // get a pointer to the TTypeData structure
  62.   ptd := GetTypeData (pti);
  63.  
  64.   // 1: access the TTypeInfo structure
  65.   sList.Add ('Type Name: ' + pti^.Name);
  66.   sList.Add ('Type Kind: ' + GetEnumName (
  67.     TypeInfo (TTypeKind),
  68.     Integer (pti^.Kind)));
  69.  
  70.   // 2: access the TTypeData structure
  71.   sList.Add ('Method Kind: ' + GetEnumName (
  72.     TypeInfo (TMethodKind),
  73.     Integer (ptd^.MethodKind)));
  74.   sList.Add ('Number of parameter: ' +
  75.     IntToStr (ptd^.ParamCount));
  76.  
  77.   // 3: access to the ParamList
  78.   // get the initial pointer and
  79.   // reset the parameters counter
  80.   pParam := PParamData (@(ptd^.ParamList));
  81.   nParam := 1;
  82.   // loop until all parameters are done
  83.   while nParam <= ptd^.ParamCount do
  84.   begin
  85.     // read the information
  86.     Line := 'Param ' + IntToStr (nParam) + ' > ';
  87.     // add type of parameter
  88.     if pfVar in pParam^.Flags then
  89.       Line := Line + 'var ';
  90.     if pfConst in pParam^.Flags then
  91.       Line := Line + 'const ';
  92.     // get the parameter name
  93.     Line := Line + pParam^.ParamName + ': ';
  94.     // one more type of parameter
  95.     if pfArray in pParam^.Flags then
  96.       Line := Line + ' array of ';
  97.     // the type name string must be located...
  98.     // moving a pointer past the params and
  99.     // the string (including its size byte)
  100.     pTypeString := Pointer (Integer (pParam) +
  101.       sizeof (TParamFlags) +
  102.       Length (pParam^.ParamName) + 1);
  103.     // add the type name
  104.     Line := Line + pTypeString^;
  105.     // finally, output the string
  106.     sList.Add (Line);
  107.     // move the pointer to the next structure,
  108.     // past the two strings (including size byte)
  109.     pParam := PParamData (Integer (pParam) +
  110.       sizeof (TParamFlags) +
  111.       Length (pParam^.ParamName) + 1 +
  112.       Length (pTypeString^) + 1);
  113.     // increase the parameters counter
  114.     Inc (nParam);
  115.   end;
  116.   // show the return type if a function
  117.   if ptd^.MethodKind = mkFunction then
  118.   begin
  119.     // at the end, instead of a param data,
  120.     // there is the return string
  121.     pReturnString := Pointer (pParam);
  122.     sList.Add ('Returns > ' + pReturnString^);
  123.   end;
  124. end;
  125.  
  126. procedure TForm1.AddType (pti: PTypeInfo);
  127. begin
  128.   ListBox1.Items.AddObject(pti^.Name, TObject (pti))
  129. end;
  130.  
  131. procedure TForm1.FormCreate(Sender: TObject);
  132. begin
  133.   AddType (TypeInfo (TNotifyEvent));
  134.   AddType (TypeInfo (TFindMethodEvent));
  135.   AddType (TypeInfo (THelpEvent));
  136.   AddType (TypeInfo (TSetNameEvent));
  137.   AddType (TypeInfo (TDragDropEvent));
  138.   AddType (TypeInfo (TDrawItemEvent));
  139.   AddType (TypeInfo (TMeasureItemEvent));
  140.   AddType (TypeInfo (TScrollEvent));
  141.   AddType (TypeInfo (TDragOverEvent));
  142.   AddType (TypeInfo (TEndDragEvent));
  143.   AddType (TypeInfo (TKeyEvent));
  144.   AddType (TypeInfo (TKeyPressEvent));
  145.   AddType (TypeInfo (TMouseEvent));
  146.   AddType (TypeInfo (TMouseMoveEvent));
  147.   AddType (TypeInfo (TStartDragEvent));
  148.   AddType (TypeInfo (TCloseEvent));
  149.   AddType (TypeInfo (TCloseQueryEvent));
  150.   AddType (TypeInfo (TExceptionEvent));
  151.   AddType (TypeInfo (TIdleEvent));
  152.   AddType (TypeInfo (TMessageEvent));
  153.   AddType (TypeInfo (TShowHintEvent));
  154. end;
  155.  
  156. end.
  157.